home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / nt / emacssrc.zip / EMACSSRC.TAR / emacs-19.17 / lisp / time.el < prev    next >
Lisp/Scheme  |  1993-07-23  |  5KB  |  134 lines
  1. ;;; time.el --- display time and load in mode line of Emacs.
  2.  
  3. ;; Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Maintainer: FSF
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22.  
  23. ;;; Commentary:
  24.  
  25. ;;; Facilities to display current time/date and a new-mail indicator
  26. ;;; in the Emacs mode line.  The single entry point is `display-time'.
  27.  
  28. ;;; Code:
  29.  
  30. (defvar display-time-mail-file nil
  31.   "*File name of mail inbox file, for indicating existence of new mail.
  32. Default is system-dependent, and is the same as used by Rmail.")
  33.  
  34. ;;;###autoload
  35. (defvar display-time-day-and-date nil "\
  36. *Non-nil means \\[display-time] should display day and date as well as time.")
  37.  
  38. (defvar display-time-process nil)
  39.  
  40. (defvar display-time-interval 60
  41.   "*Seconds between updates of time in the mode line.")
  42.  
  43. (defvar display-time-24hr-format nil
  44.   "*Non-nill indicates time should be displayed as hh:mm, 0 <= hh <= 23.
  45. Nil means 1 <= hh <= 12, and an AM/PM suffix is used.")
  46.  
  47. (defvar display-time-string nil)
  48.  
  49. (defvar display-time-hook nil
  50.   "* List of functions to be called when the time is updated on the mode line.")
  51.  
  52. ;;;###autoload
  53. (defun display-time ()
  54.   "Display current time, load level, and mail flag in mode line of each buffer.
  55. Updates automatically every minute.
  56. If `display-time-day-and-date' is non-nil, the current day and date
  57. are displayed as well.
  58. After each update, `display-time-hook' is run with `run-hooks'."
  59.   (interactive)
  60.   (let ((live (and display-time-process
  61.            (eq (process-status display-time-process) 'run))))
  62.     (if (not live)
  63.     (progn
  64.       (if display-time-process
  65.           (delete-process display-time-process))
  66.       (or global-mode-string (setq global-mode-string '("")))
  67.       (or (memq 'display-time-string global-mode-string)
  68.           (setq global-mode-string
  69.             (append global-mode-string '(display-time-string))))
  70.       (setq display-time-string "")
  71.       (setq display-time-process
  72.         (start-process "display-time" nil
  73.                    (concat exec-directory "wakeup")
  74.                    (int-to-string display-time-interval)))
  75.       (process-kill-without-query display-time-process)
  76.       (set-process-sentinel display-time-process 'display-time-sentinel)
  77.       (set-process-filter display-time-process 'display-time-filter)))))
  78.  
  79. (defun display-time-sentinel (proc reason)
  80.   (or (eq (process-status proc) 'run)
  81.       (setq display-time-string ""))
  82.   ;; Force mode-line updates
  83.   (save-excursion (set-buffer (other-buffer)))
  84.   (set-buffer-modified-p (buffer-modified-p))
  85.   (sit-for 0))
  86.  
  87. (defun display-time-filter (proc string)
  88.   (let ((time (current-time-string))
  89.     (load (condition-case ()
  90.           (if (zerop (car (load-average))) ""
  91.             (let ((str (format " %03d" (car (load-average)))))
  92.               (concat (substring str 0 -2) "." (substring str -2))))
  93.         (error "")))
  94.     (mail-spool-file (or display-time-mail-file
  95.                  (getenv "MAIL")
  96.                  (concat rmail-spool-directory
  97.                      (or (getenv "LOGNAME")
  98.                      (getenv "USER")
  99.                      (user-login-name)))))
  100.     hour am-pm-flag)
  101.     (setq hour (read (substring time 11 13)))
  102.     (if (not display-time-24hr-format)
  103.     (progn
  104.       (setq am-pm-flag (if (>= hour 12) "pm" "am"))
  105.       (if (> hour 12)
  106.           (setq hour (- hour 12))
  107.         (if (= hour 0)
  108.         (setq hour 12))))
  109.       (setq am-pm-flag ""))
  110.     (setq display-time-string
  111.       (concat (format "%d" hour) (substring time 13 16)
  112.           am-pm-flag
  113.           load
  114.           (if (and (file-exists-p mail-spool-file)
  115.                ;; file not empty?
  116.                (display-time-file-nonempty-p mail-spool-file))
  117.               " Mail"
  118.             "")))
  119.     ;; Append the date if desired.
  120.     (if display-time-day-and-date
  121.     (setq display-time-string
  122.           (concat (substring time 0 11) display-time-string))))
  123.   (run-hooks 'display-time-hook)
  124.   ;; Force redisplay of all buffers' mode lines to be considered.
  125.   (save-excursion (set-buffer (other-buffer)))
  126.   (set-buffer-modified-p (buffer-modified-p))
  127.   ;; Do redisplay right now, if no input pending.
  128.   (sit-for 0))
  129.  
  130. (defun display-time-file-nonempty-p (file)
  131.   (< 0 (nth 7 (file-attributes (file-chase-links file)))))
  132.  
  133. ;;; time.el ends here
  134.